home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok44 / m2ced / txt / errors.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  183 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    Errors.mod
  4.     :Contents.   Get errors from *.mode or *.defe-Files
  5.     :Author.     Steffen Reith
  6.     :Address.    Hessenstr. 64, D-8700 Würzburg
  7.     :Copyright.  Shareware
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga A+L V3.2d
  10.     :Imports.    Msg
  11.     :History.    V1.0  10.June 1990
  12.  
  13. **********************************************************************)
  14. (* $S- $F- $N- $R- $V- *)
  15. IMPLEMENTATION MODULE Errors;
  16.  
  17. FROM Dos     IMPORT Open,Close,FileHandlePtr,readOnly,Seek,Read,beginning,
  18.                     current;
  19. FROM Arts    IMPORT TermProcedure;
  20. FROM SYSTEM  IMPORT ADR,ADDRESS,BYTE;
  21. FROM Msg     IMPORT TitleMsg;
  22.  
  23. CONST Header=03H;           (* Errorfilekennung                           *)
  24.       ErrorMark=0C1455252H; (* Nun folgt die Fehlerposition im SourceFile *)
  25.                             (* Achtung in Dokumentation falsch deklariert *)
  26.       ErrorMarkHigh=0C145H; (* High-Word von ErrorMark                    *)
  27.       StringMark=0C2H;      (* Nun folgt eine String                      *)
  28.  
  29. VAR AktFile:FileHandlePtr;
  30.  
  31. PROCEDURE ReadLongCard(File:FileHandlePtr):LONGCARD;
  32.  
  33. VAR Dummy:LONGINT;
  34.     Value:LONGCARD;
  35.  
  36. BEGIN
  37.  Dummy:=Read(File,ADR(Value),SIZE(Value));
  38.  RETURN(Value)
  39. END ReadLongCard;
  40.  
  41. PROCEDURE ReadCard(File:FileHandlePtr):CARDINAL;
  42.  
  43. VAR Dummy:LONGINT;
  44.     Value:CARDINAL;
  45.  
  46. BEGIN
  47.  Dummy:=Read(File,ADR(Value),SIZE(Value));
  48.  RETURN(Value)
  49. END ReadCard;
  50.  
  51. PROCEDURE ReadChar(File:FileHandlePtr):CHAR;
  52.  
  53. VAR Dummy:LONGINT;
  54.     Value:CHAR;
  55.  
  56. BEGIN
  57.  Dummy:=Read(File,ADR(Value),SIZE(Value));
  58.  RETURN(Value)
  59. END ReadChar;
  60.  
  61. PROCEDURE ReadString(File:FileHandlePtr;VAR String:ARRAY OF CHAR);
  62.  
  63. VAR Dummy:LONGINT;
  64.     Buffer:CHAR;
  65.     i:INTEGER;
  66.  
  67. BEGIN
  68.  i:=0;
  69.  LOOP
  70.  
  71.   IF i>(HIGH(String)-1) THEN
  72.    TitleMsg('String in Errorfile zu lang');
  73.    String[i]:=CHAR(0);
  74.    RETURN
  75.   END;
  76.  
  77.   Dummy:=Read(File,ADR(String[i]),SIZE(String[i])); (* Zeichen fuer Zeichen *)
  78.   INC(i);                                           (* lesen, da hier Speed *)
  79.   IF String[i-1]=CHAR(0) THEN                       (* egal!!!              *)
  80.    Dummy:=Read(File,ADR(Buffer),SIZE(Buffer));
  81.    (* Evtl. 2. Nullbyte ueberlesen *)
  82.    IF Buffer#CHAR(0) THEN
  83.     Dummy:=Seek(File,-1,current); (* Das war ein kalter 1x zurueck *)
  84.    END;
  85.    RETURN
  86.   END
  87.  END
  88. END ReadString;
  89.  
  90. PROCEDURE ExistErrorFile(VAR Name:ARRAY OF CHAR):BOOLEAN;
  91.  
  92. VAR File:FileHandlePtr;
  93.     Flag:BOOLEAN;
  94.  
  95. BEGIN
  96.  File:=Open(ADR(Name),readOnly);
  97.  Flag:=File#NIL;
  98.  Close(File);
  99.  RETURN(Flag)
  100. END ExistErrorFile;
  101.  
  102. PROCEDURE OpenErrorFile(VAR Name:ARRAY OF CHAR);
  103.  
  104. VAR File:FileHandlePtr;
  105.  
  106. BEGIN
  107.  File:=Open(ADR(Name),readOnly);
  108.  IF File=NIL THEN
  109.   TitleMsg('Kann Errorfile nicht oeffnen !!');
  110.  END;
  111.  
  112.  IF AktFile#NIL THEN
  113.   Close(AktFile)
  114.  END;
  115.  AktFile:=File;
  116.  
  117.  IF ReadLongCard(File) # Header THEN TitleMsg('Kein gueltiges Errorfile') END;
  118. END OpenErrorFile;
  119.  
  120. PROCEDURE NextError(VAR SourcePos:LONGCARD; VAR ErrorNums:ErrorFeld);
  121.  
  122. CONST BuffLen=31;
  123.  
  124. VAR Ende:CARDINAL;
  125.     Dummy:LONGINT;
  126.     i:INTEGER;
  127.     Buffer:ARRAY[0..BuffLen] OF CHAR;
  128.  
  129. BEGIN
  130.  FOR i:=1 TO MaxError DO ErrorNums[i]:=0 END; (* Vorhandene Fehler loeschen *)
  131.  
  132.  Ende:=ReadCard(AktFile);
  133.  IF Ende=0FFFFH THEN
  134.   SourcePos:=0;
  135.   ErrorNums[1]:=0;
  136.   RETURN
  137.  END;
  138.  Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
  139.  IF ReadLongCard(AktFile)#ErrorMark THEN
  140.   TitleMsg('Fehler in ErrorFile');
  141.   RETURN
  142.  END;
  143.  SourcePos:=ReadLongCard(AktFile);
  144.  i:=1;
  145.  LOOP
  146.   IF ReadChar(AktFile)=CHAR(StringMark) THEN
  147.    ReadString(AktFile,Buffer);
  148.   ELSE
  149.    Dummy:=Seek(AktFile,-1*SIZE(CHAR),current); (* 1x zurueck wg. Stringmark *)
  150.    ErrorNums[i]:=ReadCard(AktFile);
  151.    IF ErrorNums[i]=ErrorMarkHigh THEN
  152.     ErrorNums[i]:=0;
  153.     Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
  154.     RETURN
  155.    END;
  156.    IF ErrorNums[i]=0FFFFH THEN (* Wenn Ende erreicht beim naechsten Aufruf *)
  157.     ErrorNums[i]:=0;           (* Gleich oben der Fehler !!                *)
  158.     Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
  159.     RETURN
  160.    END;
  161.    INC(i);
  162.    IF i=MaxError+1 THEN
  163.     TitleMsg('Implementationsbeschraenkung kann nicht alle Fehler lesen');
  164.     WHILE ReadCard(AktFile)#ErrorMarkHigh DO END; (* Restliche Fehler weg *)
  165.     Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
  166.     RETURN
  167.    END
  168.   END
  169.  END
  170. END NextError;
  171.  
  172. PROCEDURE CloseErrorFile();
  173.  
  174. BEGIN
  175.  IF AktFile#NIL THEN Close(AktFile) END;
  176.  AktFile:=NIL
  177. END CloseErrorFile;
  178.  
  179. BEGIN
  180.  AktFile:=NIL;
  181.  TermProcedure(CloseErrorFile)
  182. END Errors.
  183.